VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SmartConcat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     VBoost.Bas (optional)
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1
'   Conditional Compilation Values:
'     NOVBOOST = 1 'Removes VBoost dependency
'
' This file is discussed in Chapter 14.
'***************************************************************
Option Explicit

Private m_Separator As String

Private m_MediumGrowSize As Long
Private m_CurrentMediumSize As Long
Private m_CurrentMediumIndex As Long
Private m_MediumStrings() As String

Private m_MaxMediumLength As Long
Private m_SmallTotalLength As Long

Private m_MaxSmallEntries As Long
Private m_SmallIndex As Long
Private m_SmallStrings() As String
Private m_pSmallCount As Long

Public Function GenerateCurrentString() As String
Dim pElemCount As Long
    If m_CurrentMediumIndex Then
        If m_SmallIndex Then ClearSmallStrings True
        'Since Join concatenates all strings, we need to shrink the size
        'of the array.  In SmartConcat, this was done with ReDim Preserve.
        'Here, we do it by changing the element count in the SAFEARRAY structure
        'to fake a smaller array.
        
        'Get the array descriptor.  Note that this requires a typelib
        'for string types only because VB does ANSI/UNICODE translation
        'on VB string arrays.  The following declare is sufficient
        'for all other array types:
        'Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
        'If you need to get the array pointer for an array of strings
        'without the typelib, then simply create a Type with a single string
        'element and make the array of that type.  By the time the code
        'is compiled, there is no additional overhead.  We couldn't do that
        'in this case however because Join requires a String or Variant array.
        #If NOVBOOST Then
            CopyMemory pElemCount, ByVal VarPtrStringArray(m_MediumStrings), 4
            pElemCount = (pElemCount Xor &H80000000) + 16 Xor &H80000000
            CopyMemory ByVal pElemCount, m_CurrentMediumIndex, 4
            GenerateCurrentString = Join(m_MediumStrings, m_Separator)
            CopyMemory ByVal pElemCount, m_CurrentMediumSize, 4
        #Else
            With VBoost
                'Get the pointer to the count of items in the array
                pElemCount = .UAdd(.Deref(VarPtrStringArray(m_MediumStrings)), 16)
                'Change the array element count
                .Assign ByVal pElemCount, m_CurrentMediumIndex
                GenerateCurrentString = Join(m_MediumStrings, m_Separator)
                'Change the element count back to where it was
                .Assign ByVal pElemCount, m_CurrentMediumSize
            End With
        #End If
    Else
        ClearSmallStrings True, VarPtr(GenerateCurrentString)
    End If
End Function
Public Function ClearStrings()
    If m_SmallIndex Then ClearSmallStrings False
    m_CurrentMediumIndex = 0
    m_CurrentMediumSize = 0
    Erase m_MediumStrings
End Function
Public Sub AddString(ByVal NewString As String)
    AddStringSteal NewString
End Sub
Public Sub AddStringSteal(NewString As String)
Dim NewLen As Long
    NewLen = Len(NewString)
    If m_SmallTotalLength + NewLen > m_MaxMediumLength Then
        ClearSmallStrings True
    End If
    m_SmallTotalLength = m_SmallTotalLength + NewLen
    #If NOVBOOST Then
        m_SmallStrings(m_SmallIndex) = vbNullString
        CopyMemory ByVal VarPtr(m_SmallStrings(m_SmallIndex)), ByVal VarPtr(NewString), 4
        CopyMemory ByVal VarPtr(NewString), 0&, 4
    #Else
        VBoost.AssignSwap m_SmallStrings(m_SmallIndex), NewString
        NewString = vbNullString
    #End If
    m_SmallIndex = m_SmallIndex + 1
    If m_SmallIndex = m_MaxSmallEntries Then
        'Clear out now
        ClearSmallStrings True
    End If
End Sub
Public Property Get TempStringCount() As Long
    TempStringCount = m_MaxSmallEntries
End Property
Public Property Let TempStringCount(ByVal RHS As Long)
    If RHS < 1 Then Err.Raise 5
    If m_SmallIndex Then ClearSmallStrings True
    m_MaxSmallEntries = RHS
    ReDim Preserve m_SmallStrings(RHS - 1)
    #If NOVBOOST Then
        CopyMemory m_pSmallCount, ByVal VarPtrStringArray(m_SmallStrings), 4
        m_pSmallCount = (m_pSmallCount Xor &H80000000) + 16 Xor &H80000000
    #Else
        With VBoost
            m_pSmallCount = .UAdd(.Deref(VarPtrStringArray(m_SmallStrings)), 16)
        End With
    #End If
End Property
Public Property Get FinalCacheGrowSize() As Long
    FinalCacheGrowSize = m_MediumGrowSize
End Property
Public Property Let FinalCacheGrowSize(ByVal RHS As Long)
    If RHS < 1 Then Err.Raise 5
    If m_CurrentMediumIndex Then Err.Raise 5, , "Call before AddString or after ClearStrings"
    m_MediumGrowSize = RHS
End Property
Public Property Get MaxTempLength() As Long
    MaxTempLength = m_MaxMediumLength
End Property
Public Property Let MaxTempLength(ByVal RHS As Long)
    If RHS < 1 Then Err.Raise 5
    m_MaxMediumLength = RHS
End Property
Public Property Get Separator() As String
    Separator = m_Separator
End Property
Public Property Let Separator(ByVal RHS As String)
    #If NOVBOOST Then
        m_Separator = RHS
    #Else
        VBoost.AssignSwap m_Separator, RHS
    #End If
End Property

Private Function NextMediumIndex() As Long
    If (m_CurrentMediumIndex Mod m_MediumGrowSize) = 0 Then
        m_CurrentMediumSize = m_CurrentMediumSize + m_MediumGrowSize
        ReDim Preserve m_MediumStrings(m_CurrentMediumSize - 1)
    End If
    NextMediumIndex = m_CurrentMediumIndex
    m_CurrentMediumIndex = m_CurrentMediumIndex + 1
End Function

'Use the Join function to generate a medium length string
'and move it to our single buffer
'
'If pOutString is not zero, then the output string should
'be filled directly instead of growing the medium array. This
'can be provided when m_CurrentMediumIndex is 0 to eliminate
'creation of the medium array. pOutString is the VarPtr of a
'String variable which should be empty before this call.
Private Sub ClearSmallStrings(ByVal fDoJoin As Boolean, Optional ByVal pOutString As Long)
Dim iNextMediumIndex As Long
    Debug.Assert m_SmallIndex
    
    'Make the array smaller so Join doesn't add extra separators
    #If NOVBOOST Then
        CopyMemory ByVal m_pSmallCount, m_SmallIndex, 4
    #Else
        VBoost.Assign ByVal m_pSmallCount, m_SmallIndex
    #End If
    
    If fDoJoin Then
        If pOutString Then
            #If NOVBOOST Then
                Dim strJoin As String
                strJoin = Join(m_SmallStrings, m_Separator)
                CopyMemory ByVal pOutString, StrPtr(strJoin), 4
                CopyMemory ByVal VarPtr(strJoin), 0&, 4
            #Else
                VBoost.AssignSwap ByVal pOutString, Join(m_SmallStrings, m_Separator)
            #End If
        Else
            iNextMediumIndex = NextMediumIndex 'Note: Native/Fast bug, don't do NextMediumIndex inline
            m_MediumStrings(iNextMediumIndex) = Join(m_SmallStrings, m_Separator)
        End If
    End If
    
    'We could clear all of the current strings here, but
    'it turns out that it is slightly faster to just leave them
    'alone and let them clear out naturally as the buffer is reused
    'Change AddStringSteal to not set NewString = vbNullString if
    'this changes.
    'Dim l As Long
    'For l = 0 To m_SmallIndex - 1
    '    m_SmallStrings(l) = vbNullString
    'Next l
    
    'Reset array to where it used to be
    #If NOVBOOST Then
        CopyMemory ByVal m_pSmallCount, m_MaxSmallEntries, 4
    #Else
        VBoost.Assign ByVal m_pSmallCount, m_MaxSmallEntries
    #End If
    m_SmallIndex = 0
    m_SmallTotalLength = 0
End Sub

Private Sub Class_Initialize()
    'Set defaults and initialize array
    
    'Leave plenty of space for the length prefix and
    'system overhead without overflowing a single memory page.
    m_MaxMediumLength = 4070
    m_MaxSmallEntries = 128
    m_MediumGrowSize = 64
    ReDim m_SmallStrings(m_MaxSmallEntries - 1)
    
    'Since m_SmallStrings is used much more frequently than
    'm_MediumStrings, calculating the offset all the time is an unnecessary
    'overhead, so we cache a pointer to the address of the element count.
    #If NOVBOOST Then
        CopyMemory m_pSmallCount, ByVal VarPtrStringArray(m_SmallStrings), 4
        m_pSmallCount = (m_pSmallCount Xor &H80000000) + 16 Xor &H80000000
    #Else
        With VBoost
            m_pSmallCount = .UAdd(.Deref(VarPtrStringArray(m_SmallStrings)), 16)
        End With
    #End If
End Sub

